home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
kcl.lha
/
c
/
savemem.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
7KB
|
333 lines
/*
(C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
*/
/*
savemem.c
DG-SPECIFIC
*/
#include <stdio.h>
#include <packets:create.h>
#include "include.h"
#define $CREATE 00
#define $GNAME 0111
#define $ORDY 01
#define $FSTF 0103
#define ERFDE 025
#define ERDDE 023
#define EREOF 030
#define SV_BUFF_SIZE 2048
#define PRSTART 020000
#define UST 0400
#define USTBL 013
#define USTST 016
#define USTSZ 022
#define USTSH 031
#define RING_MASK 001777777777
#define ST_REC_SIZE 0400
FILE *fopen();
FILE *mypr;
FILE *savedpr;
extern short fas_stchan; /* .st channel for fasl io */
char sv_buffer[SV_BUFF_SIZE];
char sv_in_buff[BUFSIZ];
char sv_o_buff[BUFSIZ];
savememory(filen)
char *filen;
{
int i;
char prname[256];
get_path(filen, prname);
for (i = 0; prname[i] != '\0'; i++)
;
i -= 3;
if (i < 1 || strcmp(prname + i, ".PR") != 0)
i += 3; /* go back to last */
prname[i++] = '.';
prname[i++] = 'P';
prname[i++] = 'R';
prname[i] = '\0';
mdump(prname);
ustcopy(prname);
i -= 2;
prname[i++] = 'S';
prname[i++] = 'T';
prname[i] = '\0';
stcopy(prname);
}
/* dump my process to filen */
mdump(filen)
char *filen;
{
int ac0, ac1, ac2, ier;
unlink(filen); /* first delete it */
ac0 = &ac0; /* set ring 7 */
ac2 = filen;
if (ier = sys($MDUMP, &ac0, &ac1, &ac2))
sys_emes(ier);
}
/*
ustcopy replaces ust of memory dumped file by the original
ust of .pr file, and also clears out the C library global
variable , i.e. _fdl and _chnl_blk area to prevent the C
envirionment initializing error.
*/
ustcopy(filen)
char *filen;
{
int i, ier;
short *ust;
int impure_block;
int shared_start;
int shared_size;
int shared_block_no;
int _fdl_addr, _chnl_blk_addr;
int stack_base;
int stack_limit;
char myname[256];
get_prname(myname);
mypr = fopen(myname, "r");
if (mypr == NULL) sys_emes(lasterror());
setbuf(mypr, sv_in_buff);
savedpr = fopen(filen, "r+");
if (savedpr == NULL) sys_emes(lasterror());
setbuf(savedpr, sv_o_buff);
if (fread(sv_buffer, SV_BUFF_SIZE, 1, savedpr) != 1)
sys_emes(lasterror());
/*
remember unshared and shared size... of memory dumped file.
*/
ust = (short *)sv_buffer + UST;
impure_block = *(int *)(ust + USTBL);
shared_start = *(int *)(ust + USTST);
shared_size = *(int *)(ust + USTSZ);
shared_block_no = *(int *)(ust + USTSH);
stack_base = *((int *)sv_buffer + 0270);
stack_limit = *((int *)sv_buffer + 0267);
if (fseek(savedpr, 0, 0)) sys_emes(lasterror());
if (fread(sv_buffer, SV_BUFF_SIZE, 1, mypr) != 1)
sys_emes(lasterror());
*(int *)(ust + USTBL) = impure_block;
*(int *)(ust + USTST) = shared_start;
*(int *)(ust + USTSZ) = shared_size;
*(int *)(ust + USTSH) = shared_block_no;
if (fwrite(sv_buffer, SV_BUFF_SIZE, 1, savedpr) != 1)
sys_emes(lasterror());
for (i = 1; i < 8; i++) {
if (fread(sv_buffer, SV_BUFF_SIZE, 1, mypr) != 1)
sys_emes(lasterror());
if (fwrite(sv_buffer, SV_BUFF_SIZE, 1, savedpr) != 1)
sys_emes(lasterror());
}
/* if (fseek(mypr, PRSTART * 2, 0))
sys_emes(lasterror()); */
if (fseek(savedpr, PRSTART * 2, 0))
sys_emes(lasterror());
if (fread(sv_buffer, 050 * 2, 1, savedpr) != 1)
sys_emes(lasterror());
/*
* set up stack registers
*/
*((int *)sv_buffer + 013) = stack_base; /* stack base */
*((int *)sv_buffer + 011) = stack_base; /* stack pointer */
*((int *)sv_buffer + 012) = stack_limit; /* stack limit */
*((int *)sv_buffer + 010) = 0; /* frame pointer */
if (fseek(savedpr, PRSTART * 2, 0))
sys_emes(lasterror());
if (fwrite(sv_buffer, 050 * 2, 1, savedpr) != 1)
sys_emes(lasterror());
/*
if (fseek(mypr, (PRSTART + 0400) * 2, 0))
sys_emes(lasterror());
if (fseek(savedpr, (PRSTART + 0400) * 2, 0))
sys_emes(lasterror());
if (fread(sv_buffer, 050 * 2, 1, mypr) != 1)
sys_emes(lasterror());
if (fwrite(sv_buffer, 050 * 2, 1, savedpr) != 1)
sys_emes(lasterror());
*/
fclose(mypr);
if (fas_stchan == -1) fasl_openst();
if (ier = fasl_st("_chnl_blk", &_chnl_blk_addr))
sys_emes(ier);
if (ier = fasl_st("_fdl", &_fdl_addr))
sys_emes(ier);
_chnl_blk_addr = (_chnl_blk_addr & RING_MASK) + PRSTART;
_fdl_addr = (_fdl_addr & RING_MASK) + PRSTART;
if (fseek(savedpr, _chnl_blk_addr * 2, 0))
sys_emes(lasterror());
zero(sv_buffer, SV_BUFF_SIZE);
if (fwrite(sv_buffer, SV_BUFF_SIZE, 2, savedpr) != 2)
sys_emes(lasterror());
if (fwrite(sv_buffer, 0400, 1, savedpr) != 1)
sys_emes(lasterror());
if (fseek(savedpr, _fdl_addr * 2, 0)) sys_emes(lasterror());
if (fwrite(sv_buffer, 0200, 1, savedpr) != 1)
sys_emes(lasterror());
fclose(savedpr);
}
/*
stcopy copies .st file.
*/
stcopy(filen)
char *filen;
{
int ac0, ac1, ac2, ier;
char mystname[256];
FILE *myst;
FILE *newst;
P_CREATE crpack;
get_stname(mystname);
unlink(filen); /* if exist, delete it */
crpack.cftyp_format = $ORDY;
crpack.cftyp_entry = $FSTF;
crpack.ccps = 0;
crpack.ctim = -1;
crpack.cacp = -1;
crpack.cdeh = 0;
crpack.cdel = 4;
crpack.cmil = 3;
crpack.cmrs = 0;
ac0 = filen;
ac2 = &crpack;
if (ier = sys($CREATE, &ac0, &ac1, &ac2))
sys_emes(ier);
if ((myst = fopen(mystname, "r")) == NULL)
sys_emes(lasterror());
setbuf(myst, sv_in_buff);
if ((newst = fopen(filen, "w")) == NULL)
sys_emes(lasterror());
setbuf(newst, sv_o_buff);
for (;;) {
if (fread(sv_buffer, ST_REC_SIZE, 1, myst) != 1)
if ((ier = lasterror()) == EREOF)
break;
else
sys_emes(ier);
if (fwrite(sv_buffer, ST_REC_SIZE, 1, newst) != 1)
sys_emes(lasterror());
}
fclose(myst);
fclose(newst);
}
/*
get_path convert a filename to the full path name.
*/
get_path(filen, fpath)
char *filen;
char *fpath;
{
char dir[256];
int i, j, ac0, ac1, ac2, ier;
for (i = 0; filen[i] != '\0'; i++)
;
for (; i >=0 &&
filen[i] != ':' &&
filen[i] != '=' &&
filen[i] != '@' &&
filen[i] != '^' ; i--)
;
if (i < 0) {
dir[0] = '=';
dir[1] = '\0';
} else {
for (j = 0; j <= i; j++)
dir[j] = filen[j];
dir[j] = '\0';
if (dir[j-1] == ':' && j != 1 )
dir[j-1] = '\0';
}
ac0 = dir;
ac1 = fpath;
ac2 = 256;
if (ier = sys($GNAME, &ac0, &ac1, &ac2))
if (ier == ERFDE) /* file does not exist */
sys_emes(ERDDE); /* dir does not exist */
else
sys_emes(ier);
if (ac2 != 1)
fpath[ac2++] = ':';
for (j = ac2, i++; (fpath[j] = toupper(filen[i])) != '\0'
; j++, i++)
;
}
Lsave()
{
object x;
int len, i, ier;
char *cp;
char filen[256];
short *sp;
check_arg(1);
check_type_or_pathname_string_symbol_stream(&vs_base[0]);
x = coerce_to_namestring(vs_base[0]);
vs_push(x);
cp = x->st.st_self;
len = x->st.st_dim;
for (i=0; i < len; i++) filen[i] = cp[i];
filen[i] = '\0';
savememory(filen);
vs_top = vs_base;
vs_push(Ct);
}
init_save()
{
make_function("SAVE", Lsave);
}